home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kolekce / d6 / rxlibsetup.exe / {app} / units / RXSPLIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-02-19  |  17.0 KB  |  567 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 2001,2002 SGB Software          }
  6. {         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
  7. {                        Igor Pavluk and Serge Korolev  }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11.  
  12. unit RXSplit;
  13.  
  14. interface
  15.  
  16. {$I RX.INC}
  17.  
  18. uses Classes, {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  19.   Controls, ExtCtrls, Forms, Graphics, VCLUtils;
  20.  
  21. type
  22.  
  23. { TRxSplitter }
  24.  
  25.   TSplitterStyle = (spUnknown, spHorizontalFirst, spHorizontalSecond,
  26.     spVerticalFirst, spVerticalSecond);
  27.   TInverseMode = (imNew, imClear, imMove);
  28.   TSplitterMoveEvent = procedure (Sender: TObject; X, Y: Integer;
  29.     var AllowChange: Boolean) of object;
  30.  
  31.   TRxSplitter = class(TCustomPanel)
  32.   private
  33.     FControlFirst: TControl;
  34.     FControlSecond: TControl;
  35.     FSizing: Boolean;
  36.     FStyle: TSplitterStyle;
  37.     FPrevOrg: TPoint;
  38.     FOffset: TPoint;
  39.     FNoDropCursor: Boolean;
  40.     FLimitRect: TRect;
  41.     FTopLeftLimit: Integer;
  42.     FBottomRightLimit: Integer;
  43.     FForm: TCustomForm;
  44.     FActiveControl: TWinControl;
  45.     FAppShowHint: Boolean;
  46.     FOldKeyDown: TKeyEvent;
  47.     FOnPosChanged: TNotifyEvent;
  48.     FOnPosChanging: TSplitterMoveEvent;
  49.     function FindControl: TControl;
  50.     procedure ControlKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  51.     procedure StartInverseRect;
  52.     procedure EndInverseRect(X, Y: Integer; AllowChange, Apply: Boolean);
  53.     function GetAlign: TAlign;
  54.     procedure MoveInverseRect(X, Y: Integer; AllowChange: Boolean);
  55.     procedure ShowInverseRect(X, Y: Integer; Mode: TInverseMode);
  56.     procedure DrawSizingLine(Split: TPoint);
  57.     function GetStyle: TSplitterStyle;
  58.     function GetCursor: TCursor;
  59.     procedure SetControlFirst(Value: TControl);
  60.     procedure SetControlSecond(Value: TControl);
  61.     procedure SetAlign(Value: TAlign);
  62.     procedure StopSizing(X, Y: Integer; Apply: Boolean);
  63.     procedure CheckPosition(var X, Y: Integer);
  64.     procedure ReadOffset(Reader: TReader);
  65.     procedure WriteOffset(Writer: TWriter);
  66.   protected
  67.     procedure DefineProperties(Filer: TFiler); override;
  68.     procedure Loaded; override;
  69.     procedure Notification(AComponent: TComponent; AOperation: TOperation); override;
  70.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  71.       X, Y: Integer); override;
  72.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  73.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  74.       X, Y: Integer); override;
  75.     procedure Changed; dynamic;
  76.     procedure Changing(X, Y: Integer; var AllowChange: Boolean); dynamic;
  77.   public
  78.     constructor Create(AOwner: TComponent); override;
  79.     procedure UpdateState;
  80.   published
  81.     property ControlFirst: TControl read FControlFirst write SetControlFirst;
  82.     property ControlSecond: TControl read FControlSecond write SetControlSecond;
  83.     property Align: TAlign read GetAlign write SetAlign default alNone;
  84. {$IFDEF RX_D4}
  85.     property Constraints;
  86. {$ENDIF}
  87.     property BevelInner;
  88.     property BevelOuter;
  89.     property BevelWidth;
  90.     property BorderStyle;
  91.     property Enabled;
  92.     property Color;
  93.     property Ctl3D {$IFDEF WIN32} default False {$ENDIF};
  94.     property Cursor read GetCursor stored False;
  95.     property TopLeftLimit: Integer read FTopLeftLimit write FTopLeftLimit default 20;
  96.     property BottomRightLimit: Integer read FBottomRightLimit write FBottomRightLimit default 20;
  97.     property ParentColor;
  98.     property ParentCtl3D default False;
  99.     property ParentShowHint;
  100.     property ShowHint;
  101.     property Visible;
  102.     property OnPosChanged: TNotifyEvent read FOnPosChanged write FOnPosChanged;
  103.     property OnPosChanging: TSplitterMoveEvent read FOnPosChanging write FOnPosChanging;
  104.     property OnClick;
  105.     property OnDblClick;
  106.     property OnEnter;
  107.     property OnExit;
  108.     property OnMouseDown;
  109.     property OnMouseMove;
  110.     property OnMouseUp;
  111.     property OnResize;
  112.   end;
  113.  
  114. implementation
  115.  
  116. uses SysUtils;
  117.  
  118. const
  119.   InverseThickness = 2;
  120.   DefWidth = 3;
  121.  
  122. function CToC(C1, C2: TControl; P: TPoint): TPoint;
  123. begin
  124.   Result := C1.ScreenToClient(C2.ClientToScreen(P));
  125. end;
  126.  
  127. type
  128.   THack = class(TWinControl);
  129.  
  130. { TRxSplitter }
  131.  
  132. constructor TRxSplitter.Create(AOwner: TComponent);
  133. begin
  134.   inherited Create(AOwner);
  135.   ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
  136.     csOpaque, csDoubleClicks];
  137.   Width := 185;
  138.   Height := DefWidth;
  139.   FSizing := False;
  140.   FTopLeftLimit := 20;
  141.   FBottomRightLimit := 20;
  142.   FControlFirst := nil;
  143.   FControlSecond := nil;
  144.   ParentCtl3D := False;
  145. {$IFDEF WIN32}
  146.   Ctl3D := False;
  147. {$ENDIF}
  148. end;
  149.  
  150. procedure TRxSplitter.Loaded;
  151. begin
  152.   inherited Loaded;
  153.   UpdateState;
  154. end;
  155.  
  156. procedure TRxSplitter.DefineProperties(Filer: TFiler); { for backward compatibility }
  157. begin
  158.   inherited DefineProperties(Filer);
  159.   Filer.DefineProperty('LimitOffset', ReadOffset, WriteOffset, False);
  160. end;
  161.  
  162. procedure TRxSplitter.ReadOffset(Reader: TReader);
  163. var
  164.   I: Integer;
  165. begin
  166.   I := Reader.ReadInteger;
  167.   FTopLeftLimit := I;
  168.   FBottomRightLimit := I;
  169. end;
  170.  
  171. procedure TRxSplitter.WriteOffset(Writer: TWriter);
  172. begin
  173.   Writer.WriteInteger(FTopLeftLimit);
  174. end;
  175.  
  176. procedure TRxSplitter.UpdateState;
  177. begin
  178.   inherited Cursor := Cursor;
  179. end;
  180.  
  181. function TRxSplitter.FindControl: TControl;
  182. var
  183.   P: TPoint;
  184.   I: Integer;
  185. begin
  186.   Result := nil;
  187.   P := Point(Left, Top);
  188.   case Align of
  189.     alLeft: Dec(P.X);
  190.     alRight: Inc(P.X, Width);
  191.     alTop: Dec(P.Y);
  192.     alBottom: Inc(P.Y, Height);
  193.     else Exit;
  194.   end;
  195.   for I := 0 to Parent.ControlCount - 1 do begin
  196.     Result := Parent.Controls[I];
  197.     if PtInRect(Result.BoundsRect, P) then Exit;
  198.   end;
  199.   Result := nil;
  200. end;
  201.  
  202. procedure TRxSplitter.CheckPosition(var X, Y: Integer);
  203. begin
  204.   if X - FOffset.X < FLimitRect.Left then
  205.     X := FLimitRect.Left + FOffset.X
  206.   else if X - FOffset.X + Width > FLimitRect.Right then
  207.     X := FLimitRect.Right - Width + FOffset.X;
  208.   if Y - FOffset.Y < FLimitRect.Top then
  209.     Y := FLimitRect.Top + FOffset.Y
  210.   else if Y - FOffset.Y + Height > FLimitRect.Bottom then
  211.     Y := FLimitRect.Bottom + FOffset.Y - Height;
  212. end;
  213.  
  214. procedure TRxSplitter.StartInverseRect;
  215. var
  216.   R: TRect;
  217.   W: Integer;
  218. begin
  219.   if Parent = nil then Exit;
  220.   R := Parent.ClientRect;
  221.   FLimitRect.TopLeft := CToC(Self, Parent, Point(R.Left + FTopLeftLimit,
  222.     R.Top + FTopLeftLimit));
  223.   FLimitRect.BottomRight := CToC(Self, Parent, Point(R.Right - R.Left -
  224.     FBottomRightLimit, R.Bottom - R.Top - FBottomRightLimit));
  225.   FNoDropCursor := False;
  226.   FForm := ValidParentForm(Self);
  227.   FForm.Canvas.Handle := GetDCEx(FForm.Handle, 0, DCX_CACHE or DCX_CLIPSIBLINGS
  228.     or DCX_LOCKWINDOWUPDATE);
  229.   with FForm.Canvas do begin
  230.     Pen.Color := clWhite;
  231.     if FStyle in [spHorizontalFirst, spHorizontalSecond] then W := Height
  232.     else W := Width;
  233.     if W > InverseThickness + 1 then W := W - InverseThickness
  234.     else W := InverseThickness;
  235.     Pen.Width := W;
  236.     Pen.Mode := pmXOR;
  237.   end;
  238.   ShowInverseRect(Width div 2, Height div 2, imNew);
  239. end;
  240.  
  241. procedure TRxSplitter.EndInverseRect(X, Y: Integer; AllowChange,
  242.   Apply: Boolean);
  243. const
  244.   DecSize = 3;
  245. var
  246.   NewSize: Integer;
  247.   Rect: TRect;
  248.   W, H: Integer;
  249.   DC: HDC;
  250.   P: TPoint;
  251. begin
  252.   if FForm <> nil then begin
  253.     ShowInverseRect(0, 0, imClear);
  254.     with FForm do begin
  255.       DC := Canvas.Handle;
  256.       Canvas.Handle := 0;
  257.       ReleaseDC(Handle, DC);
  258.     end;
  259.     FForm := nil;
  260.   end;
  261.   FNoDropCursor := False;
  262.   if Parent = nil then Exit;
  263.   Rect := Parent.ClientRect;
  264.   H := Rect.Bottom - Rect.Top - Height;
  265.   W := Rect.Right - Rect.Left - Width;
  266.   if not AllowChange then begin
  267.     P := ScreenToClient(FPrevOrg);
  268.     X := P.X + FOffset.X - Width div 2;
  269.     Y := P.Y + FOffset.Y - Height div 2
  270.   end;
  271.   if not Apply then Exit;
  272.   CheckPosition(X, Y);
  273.   if (ControlFirst.Align = alRight) or
  274.     ((ControlSecond <> nil) and (ControlSecond.Align = alRight)) then
  275.   begin
  276.     X := -X;
  277.     FOffset.X := -FOffset.X;
  278.   end;
  279.   if (ControlFirst.Align = alBottom) or
  280.     ((ControlSecond <> nil) and (ControlSecond.Align = alBottom)) then
  281.   begin
  282.     Y := -Y;
  283.     FOffset.Y := -FOffset.Y;
  284.   end;
  285.   Parent.DisableAlign;
  286.   try
  287.     if FStyle = spHorizontalFirst then begin
  288.       NewSize := ControlFirst.Height + Y - FOffset.Y;
  289.       if NewSize <= 0 then NewSize := 1;
  290.       if NewSize >= H then NewSize := H - DecSize;
  291.       ControlFirst.Height := NewSize;
  292.     end
  293.     else if FStyle = spHorizontalSecond then begin
  294.       NewSize := ControlSecond.Height + Y - FOffset.Y;
  295.       if NewSize <= 0 then NewSize := 1;
  296.       if NewSize >= H then NewSize := H - DecSize;
  297.       ControlSecond.Height := NewSize;
  298.     end
  299.     else if FStyle = spVerticalFirst then begin
  300.       NewSize := ControlFirst.Width + X - FOffset.X;
  301.       if NewSize <= 0 then NewSize := 1;
  302.       if NewSize >= W then NewSize := W - DecSize;
  303.       ControlFirst.Width := NewSize;
  304.     end
  305.     else if FStyle = spVerticalSecond then begin
  306.       NewSize := ControlSecond.Width + X - FOffset.X;
  307.       if NewSize <= 0 then NewSize := 1;
  308.       if NewSize >= W then NewSize := W - DecSize;
  309.       ControlSecond.Width := NewSize;
  310.     end;
  311.   finally
  312.     Parent.EnableAlign;
  313.   end;
  314. end;
  315.  
  316. procedure TRxSplitter.MoveInverseRect(X, Y: Integer; AllowChange: Boolean);
  317. var
  318.   P: TPoint;
  319.   NoDrop: Boolean;
  320. begin
  321.   if not AllowChange then begin
  322.     SetCursor(Screen.Cursors[crNoDrop]);
  323.     Exit;
  324.   end;
  325.   P := Point(X, Y);
  326.   CheckPosition(X, Y);
  327.   NoDrop := not AllowChange or (((X <> P.X) and (FStyle in [spVerticalFirst,
  328.     spVerticalSecond])) or ((Y <> P.Y) and (FStyle in [spHorizontalFirst,
  329.     spHorizontalSecond])));
  330.   if NoDrop <> FNoDropCursor then begin
  331.     FNoDropCursor := NoDrop;
  332.     if NoDrop then SetCursor(Screen.Cursors[crNoDrop])
  333.     else SetCursor(Screen.Cursors[Cursor]);
  334.   end;
  335.   ShowInverseRect(X - FOffset.X + Width div 2, Y - FOffset.Y + Height div 2,
  336.     imMove);
  337. end;
  338.  
  339. procedure TRxSplitter.ShowInverseRect(X, Y: Integer; Mode: TInverseMode);
  340. var
  341.   P: TPoint;
  342.   MaxRect: TRect;
  343.   Horiz: Boolean;
  344. begin
  345.   P := Point(0, 0);
  346.   if FStyle in [spHorizontalFirst, spHorizontalSecond] then begin
  347.     P.Y := Y;
  348.     Horiz := True;
  349.   end
  350.   else begin
  351.     P.X := X;
  352.     Horiz := False;
  353.   end;
  354.   MaxRect := Parent.ClientRect;
  355.   P := ClientToScreen(P);
  356.   with P, MaxRect do begin
  357.     TopLeft := Parent.ClientToScreen(TopLeft);
  358.     BottomRight := Parent.ClientToScreen(BottomRight);
  359.     if X < Left then X := Left;
  360.     if X > Right then X := Right;
  361.     if Y < Top then Y := Top;
  362.     if Y > Bottom then Y := Bottom;
  363.   end;
  364.   if (Mode = imMove) then
  365.     if ((P.X = FPrevOrg.X) and not Horiz) or
  366.       ((P.Y = FPrevOrg.Y) and Horiz) then Exit;
  367.   if Mode in [imClear, imMove] then
  368.     DrawSizingLine(FPrevOrg);
  369.   if Mode in [imNew, imMove] then begin
  370.     DrawSizingLine(P);
  371.     FPrevOrg := P;
  372.   end;
  373. end;
  374.  
  375. procedure TRxSplitter.DrawSizingLine(Split: TPoint);
  376. var
  377.   P: TPoint;
  378. begin
  379.   if FForm <> nil then begin
  380.     P := FForm.ScreenToClient(Split);
  381.     with FForm.Canvas do begin
  382.       MoveTo(P.X, P.Y);
  383.       if FStyle in [spHorizontalFirst, spHorizontalSecond] then
  384.         LineTo(CToC(FForm, Self, Point(Width, 0)).X, P.Y)
  385.       else LineTo(P.X, CToC(FForm, Self, Point(0, Height)).Y);
  386.     end;
  387.   end;
  388. end;
  389.  
  390. function TRxSplitter.GetStyle: TSplitterStyle;
  391. begin
  392.   Result := spUnknown;
  393.   if ControlFirst <> nil then begin
  394.     if ((ControlFirst.Align = alTop) and ((ControlSecond = nil) or
  395.        (ControlSecond.Align = alClient))) or
  396.        ((ControlFirst.Align = alBottom) and ((ControlSecond = nil) or
  397.        (ControlSecond.Align = alClient))) then
  398.       Result := spHorizontalFirst
  399.     else if ((ControlFirst.Align = alClient) and (ControlSecond <> nil) and
  400.        (ControlSecond.Align = alBottom)) or
  401.        ((ControlFirst.Align = alClient) and (ControlSecond <> nil) and
  402.        (ControlSecond.Align = alTop)) then
  403.       Result := spHorizontalSecond
  404.     else if ((ControlFirst.Align = alLeft) and ((ControlSecond = nil) or
  405.        (ControlSecond.Align = alClient))) or
  406.        ((ControlFirst.Align = alRight) and ((ControlSecond = nil) or
  407.        (ControlSecond.Align = alClient))) then
  408.       Result := spVerticalFirst
  409.     else if ((ControlFirst.Align = alClient) and (ControlSecond <> nil) and
  410.        (ControlSecond.Align = alRight)) or
  411.        ((ControlFirst.Align = alClient) and (ControlSecond <> nil) and
  412.        (ControlSecond.Align = alLeft)) then
  413.       Result := spVerticalSecond;
  414.     case Result of
  415.       spHorizontalFirst, spVerticalFirst:
  416.         if Align <> FControlFirst.Align then Result := spUnknown;
  417.       spHorizontalSecond, spVerticalSecond:
  418.         if Align <> FControlSecond.Align then Result := spUnknown;
  419.     end;
  420.   end;
  421. end;
  422.  
  423. procedure TRxSplitter.SetAlign(Value: TAlign);
  424. begin
  425.   if not (Align in [alTop, alBottom, alLeft, alRight]) then begin
  426.     inherited Align := Value;
  427.     if not (csReading in ComponentState) then begin
  428.       if Value in [alTop, alBottom] then Height := DefWidth
  429.       else if Value in [alLeft, alRight] then Width := DefWidth;
  430.     end;
  431.   end
  432.   else inherited Align := Value;
  433.   if (ControlFirst = nil) and (ControlSecond = nil) then
  434.     ControlFirst := FindControl;
  435. end;
  436.  
  437. function TRxSplitter.GetAlign: TAlign;
  438. begin
  439.   Result := inherited Align;
  440. end;
  441.  
  442. function TRxSplitter.GetCursor: TCursor;
  443. begin
  444.   Result := crDefault;
  445.   case GetStyle of
  446.     spHorizontalFirst, spHorizontalSecond: Result := crVSplit;
  447.     spVerticalFirst, spVerticalSecond: Result := crHSplit;
  448.   end;
  449. end;
  450.  
  451. procedure TRxSplitter.SetControlFirst(Value: TControl);
  452. begin
  453.   if Value <> FControlFirst then begin
  454.     if (Value = Self) or (Value is TForm) then FControlFirst := nil
  455.     else begin
  456.       FControlFirst := Value;
  457. {$IFDEF WIN32}
  458.       if Value <> nil then Value.FreeNotification(Self);
  459. {$ENDIF}
  460.     end;
  461.     UpdateState;
  462.   end;
  463. end;
  464.  
  465. procedure TRxSplitter.SetControlSecond(Value: TControl);
  466. begin
  467.   if Value <> FControlSecond then begin
  468.     if (Value = Self) or (Value is TForm) then FControlSecond := nil
  469.     else begin
  470.       FControlSecond := Value;
  471. {$IFDEF WIN32}
  472.       if Value <> nil then Value.FreeNotification(Self);
  473. {$ENDIF}
  474.     end;
  475.     UpdateState;
  476.   end;
  477. end;
  478.  
  479. procedure TRxSplitter.Notification(AComponent: TComponent; AOperation: TOperation);
  480. begin
  481.   inherited Notification(AComponent, AOperation);
  482.   if AOperation = opRemove then begin
  483.     if AComponent = ControlFirst then ControlFirst := nil
  484.     else if AComponent = ControlSecond then ControlSecond := nil;
  485.   end;
  486. end;
  487.  
  488. procedure TRxSplitter.Changed;
  489. begin
  490.   if Assigned(FOnPosChanged) then FOnPosChanged(Self);
  491. end;
  492.  
  493. procedure TRxSplitter.Changing(X, Y: Integer; var AllowChange: Boolean);
  494. begin
  495.   if Assigned(FOnPosChanging) then FOnPosChanging(Self, X, Y, AllowChange);
  496. end;
  497.  
  498. procedure TRxSplitter.StopSizing(X, Y: Integer; Apply: Boolean);
  499. var
  500.   AllowChange: Boolean;
  501. begin
  502.   if FSizing then begin
  503.     ReleaseCapture;
  504.     AllowChange := Apply;
  505.     if Apply then Changing(X, Y, AllowChange);
  506.     EndInverseRect(X, Y, AllowChange, Apply);
  507.     FSizing := False;
  508.     Application.ShowHint := FAppShowHint;
  509.     if Assigned(FActiveControl) then begin
  510.       THack(FActiveControl).OnKeyDown := FOldKeyDown;
  511.       FActiveControl := nil;
  512.     end;
  513.     if Apply then Changed;
  514.   end;
  515. end;
  516.  
  517. procedure TRxSplitter.ControlKeyDown(Sender: TObject; var Key: Word;
  518.   Shift: TShiftState);
  519. begin
  520.   if Key = VK_ESCAPE then StopSizing(0, 0, False)
  521.   else if Assigned(FOldKeyDown) then FOldKeyDown(Sender, Key, Shift);
  522. end;
  523.  
  524. procedure TRxSplitter.MouseDown(Button: TMouseButton; Shift: TShiftState;
  525.   X, Y: Integer);
  526. begin
  527.   inherited MouseDown(Button, Shift, X, Y);
  528.   if not (csDesigning in ComponentState) and (Button = mbLeft) then begin
  529.     FStyle := GetStyle;
  530.     if FStyle <> spUnknown then begin
  531.       FSizing := True;
  532.       FAppShowHint := Application.ShowHint;
  533.       SetCapture(Handle);
  534.       with ValidParentForm(Self) do begin
  535.         if ActiveControl <> nil then FActiveControl := ActiveControl
  536.         else FActiveControl := GetParentForm(Self);
  537.         FOldKeyDown := THack(FActiveControl).OnKeyDown;
  538.         THack(FActiveControl).OnKeyDown := ControlKeyDown;
  539.       end;
  540.       Application.ShowHint := False;
  541.       FOffset := Point(X, Y);
  542.       StartInverseRect;
  543.     end;
  544.   end;
  545. end;
  546.  
  547. procedure TRxSplitter.MouseMove(Shift: TShiftState; X, Y: Integer);
  548. var
  549.   AllowChange: Boolean;
  550. begin
  551.   inherited MouseMove(Shift, X, Y);
  552.   if (GetCapture = Handle) and FSizing then begin
  553.     AllowChange := True;
  554.     Changing(X, Y, AllowChange);
  555.     MoveInverseRect(X, Y, AllowChange);
  556.   end;
  557. end;
  558.  
  559. procedure TRxSplitter.MouseUp(Button: TMouseButton; Shift: TShiftState;
  560.   X, Y: Integer);
  561. begin
  562.   StopSizing(X, Y, True);
  563.   inherited MouseUp(Button, Shift, X, Y);
  564. end;
  565.  
  566. end.
  567.